home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / os2 / e33el2.zip / emacs / 19.33 / lisp / tpu-mapper.el < prev    next >
Lisp/Scheme  |  1996-02-17  |  15KB  |  396 lines
  1. ;;; tpu-mapper.el --- Create a TPU-edt X-windows keymap file
  2.  
  3. ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Rob Riepel <riepel@networking.stanford.edu>
  6. ;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
  7. ;; Keywords: emulations
  8.  
  9. ;; This file is part of GNU Emacs.
  10.  
  11. ;; GNU Emacs is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; GNU Emacs is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;; GNU General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24. ;; Boston, MA 02111-1307, USA.
  25.  
  26. ;;; Commentary:
  27.  
  28. ;;  This emacs lisp program can be used to create an emacs lisp file that
  29. ;;  defines the TPU-edt keypad for emacs running on x-windows.  Please read
  30. ;;  the "Usage" AND "Known Problems" sections before attempting to run this
  31. ;;  program.
  32.  
  33. ;;; Usage:
  34.  
  35. ;;  Simply load this file into the X-windows version of emacs using the
  36. ;;  following command.
  37.  
  38. ;;    emacs -q -l tpu-mapper
  39.  
  40. ;;  The "-q" option prevents loading of your .emacs file (commands therein
  41. ;;  might confuse this program).
  42.  
  43. ;;  An instruction screen showing the TPU-edt keypad will be displayed, and
  44. ;;  you will be prompted to press the TPU-edt editing keys.  Tpu-mapper uses
  45. ;;  the keys you press to create an Emacs Lisp file that will define a
  46. ;;  TPU-edt keypad for your X server.  You can even re-arrange the standard
  47. ;;  EDT keypad to suit your tastes (or to cope with those silly Sun and PC
  48. ;;  keypads).
  49.  
  50. ;;  Finally, you will be prompted for the name of the file to store the key
  51. ;;  definitions.  If you chose the default, TPU-edt will find it and load it
  52. ;;  automatically.  If you specify a different file name, you will need to
  53. ;;  set the variable "tpu-xkeys-file" before starting TPU-edt.  Here's how
  54. ;;  you might go about doing that in your .emacs file.
  55.  
  56. ;;    (setq tpu-xkeys-file (expand-file-name "~/.my-emacs-x-keys"))
  57. ;;    (tpu-edt)
  58.  
  59. ;;; Known Problems:
  60.  
  61. ;;  Sometimes, tpu-mapper will ignore a key you press, and just continue to
  62. ;;  prompt for the same key.  This can happen when your window manager sucks
  63. ;;  up the key and doesn't pass it on to Emacs, or it could be an Emacs bug.
  64. ;;  Either way, there's nothing that tpu-mapper can do about it.  You must
  65. ;;  press RETURN, to skip the current key and continue.  Later, you and/or
  66. ;;  your local X guru can try to figure out why the key is being ignored.
  67.  
  68. ;;; Code:
  69.  
  70.  
  71. ;;;
  72. ;;;  Make sure we're running X-windows and Emacs version 19
  73. ;;;
  74. (cond
  75.  ((not (and window-system (not (string-lessp emacs-version "19"))))
  76.   (error "tpu-mapper requires running in Emacs 19, with an X display")))
  77.  
  78.  
  79. ;;;
  80. ;;;  Decide whether we're running Lucid Emacs or Emacs itself.
  81. ;;;
  82. (defconst tpu-lucid-emacs19-p (string-match "Lucid" emacs-version)
  83.   "Non-NIL if we are running Lucid Emacs version 19.")
  84.  
  85.  
  86. ;;;
  87. ;;;  Key variables
  88. ;;;
  89. (defvar tpu-kp4 nil)
  90. (defvar tpu-kp5 nil)
  91. (defvar tpu-key nil)
  92. (defvar tpu-enter nil)
  93. (defvar tpu-return nil)
  94. (defvar tpu-key-seq nil)
  95. (defvar tpu-enter-seq nil)
  96. (defvar tpu-return-seq nil)
  97.  
  98.  
  99. ;;;
  100. ;;;  Make sure the window is big enough to display the instructions
  101. ;;;
  102. (if tpu-lucid-emacs19-p (set-screen-size (selected-screen) 80 36)
  103.   (set-frame-size (selected-frame) 80 36))
  104.  
  105.  
  106. ;;;
  107. ;;;  Create buffers - Directions, Keys, Gold-Keys
  108. ;;;
  109. (if (not (get-buffer "Directions")) (generate-new-buffer "Directions"))
  110. (if (not (get-buffer "Keys")) (generate-new-buffer "Keys"))
  111. (if (not (get-buffer "Gold-Keys")) (generate-new-buffer "Gold-Keys"))
  112.  
  113.  
  114. ;;;
  115. ;;;  Put headers in the Keys buffer
  116. ;;;
  117. (set-buffer "Keys")
  118. (insert "\
  119. ;;  Key definitions for TPU-edt
  120. ;;
  121. ")
  122.  
  123.  
  124. ;;;
  125. ;;;   Display directions
  126. ;;;
  127. (switch-to-buffer "Directions")
  128. (insert "
  129.     This program prompts you to press keys to create a custom keymap file
  130.     for use with the x-windows version of Emacs and TPU-edt.
  131.  
  132.     Start by pressing the RETURN key, and continue by pressing the keys
  133.     specified in the mini-buffer.  You can re-arrange the TPU-edt keypad
  134.     by pressing any key you want at any prompt.  If you want to entirely
  135.     omit a key, just press RETURN at the prompt.
  136.  
  137.     Here's a picture of the standard TPU/edt keypad for reference:
  138.  
  139.           _______________________    _______________________________
  140.          | HELP  |      Do       |  |       |       |       |       |
  141.          |KeyDefs|               |  |       |       |       |       |
  142.          |_______|_______________|  |_______|_______|_______|_______|
  143.           _______________________    _______________________________
  144.          | Find  |Insert |Remove |  | Gold  | HELP  |FndNxt | Del L |
  145.          |       |       |Sto Tex|  |  key  |E-Help | Find  |Undel L|
  146.          |_______|_______|_______|  |_______|_______|_______|_______|
  147.          |Select |Pre Scr|Nex Scr|  | Page  | Sect  |Append | Del W |
  148.          | Reset |Pre Win|Nex Win|  |  Do   | Fill  |Replace|Undel W|
  149.          |_______|_______|_______|  |_______|_______|_______|_______|
  150.                  |Move up|          |Forward|Reverse|Remove | Del C |
  151.                  |  Top  |          |Bottom |  Top  |Insert |Undel C|
  152.           _______|_______|_______   |_______|_______|_______|_______|
  153.          |Mov Lef|Mov Dow|Mov Rig|  | Word  |  EOL  | Char  |       |
  154.          |StaOfLi|Bottom |EndOfLi|  |ChngCas|Del EOL|SpecIns| Enter |
  155.          |_______|_______|_______|  |_______|_______|_______|       |
  156.                                     |     Line      |Select | Subs  |
  157.                                     |   Open Line   | Reset |       |
  158.                                     |_______________|_______|_______|
  159.  
  160.  
  161. ")
  162. (delete-other-windows)
  163. (goto-char (point-min))
  164.  
  165. ;;;
  166. ;;;  Save <CR> for future reference
  167. ;;;
  168. (cond
  169.  (tpu-lucid-emacs19-p
  170.   (setq tpu-return-seq (read-key-sequence "Hit carriage-return <CR> to continue "))
  171.   (setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]")))
  172.  (t
  173.   (message "Hit carriage-return <CR> to continue ")
  174.   (setq tpu-return-seq (read-event))
  175.   (setq tpu-return (concat "[" (format "%s" tpu-return-seq) "]"))))
  176.  
  177.  
  178. ;;;
  179. ;;;  Key mapping functions
  180. ;;;
  181. (defun tpu-lucid-map-key (ident descrip func gold-func)
  182.   (interactive)
  183.   (setq tpu-key-seq (read-key-sequence (format "Press %s%s: " ident descrip)))
  184.   (setq tpu-key (concat "[" (format "%s" (event-key (aref tpu-key-seq 0))) "]"))
  185.   (cond ((not (equal tpu-key tpu-return))
  186.      (set-buffer "Keys")
  187.      (insert (format"(global-set-key %s %s)\n" tpu-key func))
  188.      (set-buffer "Gold-Keys")
  189.      (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func))
  190.      (set-buffer "Directions"))
  191.     ;; bogosity to get next prompt to come up, if the user hits <CR>!
  192.     ;; check periodically to see if this is still needed...
  193.     (t
  194.      (format "%s" tpu-key)))
  195.   tpu-key)
  196.  
  197. (defun tpu-emacs-map-key (ident descrip func gold-func)
  198.   (interactive)
  199.   (message "Press %s%s: " ident descrip)
  200.   (setq tpu-key-seq (read-event))
  201.   (setq tpu-key (concat "[" (format "%s" tpu-key-seq) "]"))
  202.   (cond ((not (equal tpu-key tpu-return))
  203.      (set-buffer "Keys")
  204.      (insert (format"(global-set-key %s %s)\n" tpu-key func))
  205.      (set-buffer "Gold-Keys")
  206.      (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func))
  207.      (set-buffer "Directions"))
  208.     ;; bogosity to get next prompt to come up, if the user hits <CR>!
  209.     ;; check periodically to see if this is still needed...
  210.     (t
  211.      (format "%s" tpu-key)))
  212.   tpu-key)
  213.  
  214. (fset 'tpu-map-key (if tpu-lucid-emacs19-p 'tpu-lucid-map-key 'tpu-emacs-map-key))
  215.  
  216.  
  217. (set-buffer "Keys")
  218. (insert "
  219. ;;  Arrows
  220. ;;
  221. ")
  222. (set-buffer "Gold-Keys")
  223. (insert "
  224. ;;  GOLD Arrows
  225. ;;
  226. ")
  227. (set-buffer "Directions")
  228.  
  229. (t